home *** CD-ROM | disk | FTP | other *** search
/ PC Users 1998 June / Cd Pc Users 9.iso / prog / inst / registro / registry.bas < prev    next >
Encoding:
BASIC Source File  |  1997-07-02  |  9.3 KB  |  251 lines
  1. Attribute VB_Name = "mdlRegistry"
  2. 'I find this file on the web but I don't remember
  3. 'where. I don't know the name of the author but
  4. 'he's very good. An excellent example of simple and
  5. 'clear way of programming. I fixed some tiny bugs.
  6. '
  7. '                                   K.Driblinov
  8. '  http://www.geocities.com/SiliconValley/Lakes/7057
  9. '            email:kriblinov@geocities.com
  10.  
  11. Option Explicit
  12.  
  13. Global Const REG_SZ As Long = 1
  14. Global Const REG_DWORD As Long = 4
  15.  
  16. Global Const HKEY_CLASSES_ROOT = &H80000000
  17. Global Const HKEY_CURRENT_USER = &H80000001
  18. Global Const HKEY_LOCAL_MACHINE = &H80000002
  19. Global Const HKEY_USERS = &H80000003
  20.  
  21. Global Const ERROR_NONE = 0
  22. Global Const ERROR_BADDB = 1
  23. Global Const ERROR_BADKEY = 2
  24. Global Const ERROR_CANTOPEN = 3
  25. Global Const ERROR_CANTREAD = 4
  26. Global Const ERROR_CANTWRITE = 5
  27. Global Const ERROR_OUTOFMEMORY = 6
  28. Global Const ERROR_INVALID_PARAMETER = 7
  29. Global Const ERROR_ACCESS_DENIED = 8
  30. Global Const ERROR_INVALID_PARAMETERS = 87
  31. Global Const ERROR_NO_MORE_ITEMS = 259
  32.  
  33. Global Const KEY_ALL_ACCESS = &H3F
  34.  
  35. Global Const REG_OPTION_NON_VOLATILE = 0
  36.  
  37. Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
  38. Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, ByVal lpSecurityAttributes As Long, phkResult As Long, lpdwDisposition As Long) As Long
  39. Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
  40. Declare Function RegQueryValueExString Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
  41. Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Long, lpcbData As Long) As Long
  42. Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As Long, lpcbData As Long) As Long
  43. Declare Function RegSetValueExString Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpValue As String, ByVal cbData As Long) As Long
  44. Declare Function RegSetValueExLong Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpValue As Long, ByVal cbData As Long) As Long
  45. Private Declare Function RegDeleteKey& Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String)
  46. Private Declare Function RegDeleteValue& Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String)
  47.  
  48. Public Function DeleteKey(lPredefinedKey As Long, sKeyName As String)
  49. ' Description:
  50. '   This Function will Delete a key
  51. '
  52. ' Syntax:
  53. '   DeleteKey Location, KeyName
  54. '
  55. '   Location must equal HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_lOCAL_MACHINE
  56. '   , HKEY_USERS
  57. '
  58. '   KeyName is name of the key you wish to delete, it may include subkeys (example "Key1\SubKey1")
  59.  
  60.  
  61.     Dim lRetVal As Long         'result of the SetValueEx function
  62.     Dim hKey As Long         'handle of open key
  63.     
  64.     'open the specified key
  65.     
  66.     'lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
  67.     lRetVal = RegDeleteKey(lPredefinedKey, sKeyName)
  68.     'RegCloseKey (hKey)
  69. End Function
  70.  
  71. Public Function DeleteValue(lPredefinedKey As Long, sKeyName As String, sValueName As String)
  72. ' Description:
  73. '   This Function will delete a value
  74. '
  75. ' Syntax:
  76. '   DeleteValue Location, KeyName, ValueName
  77. '
  78. '   Location must equal HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_lOCAL_MACHINE
  79. '   , HKEY_USERS
  80. '
  81. '   KeyName is the name of the key that the value you wish to delete is in
  82. '   , it may include subkeys (example "Key1\SubKey1")
  83. '
  84. '   ValueName is the name of value you wish to delete
  85.  
  86.        Dim lRetVal As Long         'result of the SetValueEx function
  87.        Dim hKey As Long         'handle of open key
  88.  
  89.        'open the specified key
  90.  
  91.        lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
  92.        lRetVal = RegDeleteValue(hKey, sValueName)
  93.        RegCloseKey (hKey)
  94. End Function
  95.  
  96. Public Function SetValueEx(ByVal hKey As Long, sValueName As String, lType As Long, vValue As Variant) As Long
  97.     Dim lValue As Long
  98.     Dim sValue As String
  99.  
  100.     Select Case lType
  101.         Case REG_SZ
  102.             sValue = vValue
  103.             SetValueEx = RegSetValueExString(hKey, sValueName, 0&, lType, sValue, Len(sValue))
  104.         Case REG_DWORD
  105.             lValue = vValue
  106.             SetValueEx = RegSetValueExLong(hKey, sValueName, 0&, lType, lValue, 4)
  107.         End Select
  108.  
  109. End Function
  110.  
  111.  
  112.  
  113.  
  114.  
  115. Function QueryValueEx(ByVal lhKey As Long, ByVal szValueName As String, vValue As Variant) As Long
  116.     Dim cch As Long
  117.     Dim lrc As Long
  118.     Dim lType As Long
  119.     Dim lValue As Long
  120.     Dim sValue As String
  121.  
  122.     On Error GoTo QueryValueExError
  123.  
  124.  
  125.  
  126.     ' Determine the size and type of data to be read
  127.  
  128.     lrc = RegQueryValueExNULL(lhKey, szValueName, 0&, lType, 0&, cch)
  129.     If lrc <> ERROR_NONE Then Error 5
  130.  
  131.     Select Case lType
  132.         ' For strings
  133.         Case REG_SZ:
  134.             sValue = String(cch, 0)
  135.             lrc = RegQueryValueExString(lhKey, szValueName, 0&, lType, sValue, cch)
  136.             If lrc = ERROR_NONE Then
  137.                 vValue = Left$(sValue, cch)
  138.             Else
  139.                 vValue = Empty
  140.             End If
  141.  
  142.         ' For DWORDS
  143.         Case REG_DWORD:
  144.             lrc = RegQueryValueExLong(lhKey, szValueName, 0&, lType, lValue, cch)
  145.             If lrc = ERROR_NONE Then vValue = lValue
  146.         Case Else
  147.             'all other data types not supported
  148.             lrc = -1
  149.     End Select
  150.  
  151. QueryValueExExit:
  152.  
  153.     QueryValueEx = lrc
  154.     Exit Function
  155.  
  156. QueryValueExError:
  157.  
  158.     Resume QueryValueExExit
  159.  
  160. End Function
  161. Public Function CreateNewKey(lPredefinedKey As Long, sNewKeyName As String)
  162. ' Description:
  163. '   This Function will create a new key
  164. '
  165. ' Syntax:
  166. '   QueryValue Location, KeyName
  167. '
  168. '   Location must equal HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_lOCAL_MACHINE
  169. '   , HKEY_USERS
  170. '
  171. '   KeyName is name of the key you wish to create, it may include subkeys (example "Key1\SubKey1")
  172.  
  173.     
  174.     
  175.     Dim hNewKey As Long         'handle to the new key
  176.     Dim lRetVal As Long         'result of the RegCreateKeyEx function
  177.     
  178.     lRetVal = RegCreateKeyEx(lPredefinedKey, sNewKeyName, 0&, vbNullString, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, 0&, hNewKey, lRetVal)
  179.     RegCloseKey (hNewKey)
  180. End Function
  181.  
  182.  
  183. Sub Main()
  184.     'Examples of each function:
  185.     'CreateNewKey HKEY_CURRENT_USER, "TestKey\SubKey1\SubKey2"
  186.     'SetKeyValue HKEY_CURRENT_USER, "TestKey\SubKey1", "Test", "Testing, Testing", REG_SZ
  187.     'MsgBox QueryValue(HKEY_CURRENT_USER, "TestKey\SubKey1", "Test")
  188.     'DeleteKey HKEY_CURRENT_USER, "TestKey\SubKey1\SubKey2"
  189.     'DeleteValue HKEY_CURRENT_USER, "TestKey\SubKey1", "Test"
  190. End Sub
  191.  
  192.  
  193. Public Function SetKeyValue(lPredefinedKey As Long, sKeyName As String, sValueName As String, vValueSetting As Variant, lValueType As Long)
  194. ' Description:
  195. '   This Function will set the data field of a value
  196. '
  197. ' Syntax:
  198. '   QueryValue Location, KeyName, ValueName, ValueSetting, ValueType
  199. '
  200. '   Location must equal HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_lOCAL_MACHINE
  201. '   , HKEY_USERS
  202. '
  203. '   KeyName is the key that the value is under (example: "Key1\SubKey1")
  204. '
  205. '   ValueName is the name of the value you want create, or set the value of (example: "ValueTest")
  206. '
  207. '   ValueSetting is what you want the value to equal
  208. '
  209. '   ValueType must equal either REG_SZ (a string) Or REG_DWORD (an integer)
  210.  
  211.        Dim lRetVal As Long         'result of the SetValueEx function
  212.        Dim hKey As Long         'handle of open key
  213.  
  214.        'open the specified key
  215.  
  216.        lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
  217.        lRetVal = SetValueEx(hKey, sValueName, lValueType, vValueSetting)
  218.        RegCloseKey (hKey)
  219.  
  220. End Function
  221.  
  222. Public Function QueryValue(lPredefinedKey As Long, sKeyName As String, sValueName As String)
  223. ' Description:
  224. '   This Function will return the data field of a value
  225. '
  226. ' Syntax:
  227. '   Variable = QueryValue(Location, KeyName, ValueName)
  228. '
  229. '   Location must equal HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_lOCAL_MACHINE
  230. '   , HKEY_USERS
  231. '
  232. '   KeyName is the key that the value is under (example: "Software\Microsoft\Windows\CurrentVersion\Explorer")
  233. '
  234. '   ValueName is the name of the value you want to access (example: "link")
  235.  
  236.        Dim lRetVal As Long         'result of the API functions
  237.        Dim hKey As Long         'handle of opened key
  238.        Dim vValue As Variant      'setting of queried value
  239.  
  240.  
  241.        lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
  242.        lRetVal = QueryValueEx(hKey, sValueName, vValue)
  243.        QueryValue = vValue
  244.        RegCloseKey (hKey)
  245. End Function
  246.  
  247.  
  248.  
  249.  
  250.  
  251.